﻿<%
'本类使用到Fso,请注意实例化Fso(还是应独立开)
'''文件缓存类
Class CacheClass
	
	'''缓存对象字典,允许访问缓存数量,缓存过期时间,缓存文件扩展名
	Public Items, CountEnabled, Expires, FileType
	
	'''缓存路径
	Private s_path
	
	'''构造
	Private Sub Class_Initialize()
		Set Items = Server.CreateObject(C_DicName)
		s_path = Server.MapPath("/" & C_DataFolder & "/" & C_CacheFolder & "/_data") & "\"
		CountEnabled = True
		Expires = 5
		FileType = ".cache"
		'Easp.Error(91) = "当前对象不允许缓存到内存缓存"
		'Easp.Error(92) = "缓存文件不存在"
		'Easp.Error(93) = "当前内容不允许缓存到文件缓存"
	End Sub
	
	'''析构
	Private Sub Class_Terminate()
		Set Items = Nothing
	End Sub
	
	'''建立缓存对象
	Public Function [New]()
		Set [New] = New CacheClass
	End Function
	
	'''底层获取所有缓存数量
	Private Function cacheCount_()
		cacheCount_ = 0
		Dim n : n = GetApp("%Ashapo_Cache_Count%")
		If IsArray(n) Then
			If Ubound(n) = 1 Then cacheCount_ = n(0)
		End If
	End Function
	
	'''查询缓存数量接口
	Public Property Get Count
		Count = IIF(CountEnabled,cacheCount_(),-1)
	End Property
	
	'''存储缓存
	Public Property Let Item(Byval p_p, Byval p_v)
		If IsNull(p_p) Then
			p_p = ""
		End If
		If Not IsObject(Items(p_p)) Then
			Set Items(p_p) = New CacheInfo
			Items(p_p).CountEnabled = CountEnabled
			Items(p_p).Expires = Expires
			Items(p_p).FileType = FileType
		End If
		Items(p_p).Name = p_p
		Items(p_p).Value = p_v
		Items(p_p).SavePath = s_path
	End Property
	
	'''取回缓存,默认
	Public Default Property Get Item(Byval p_p)
		If Not IsObject(Items(p_p)) Then
			Set Items(p_p) = New CacheInfo
			Items(p_p).Name = p_p
			Items(p_p).SavePath = s_path
			Items(p_p).CountEnabled = CountEnabled
			Items(p_p).Expires = Expires
			Items(p_p).FileType = FileType
		End If
		Set Item = Items(p_p)
	End Property
	
	'''设置缓存路径
	Public Property Let SavePath(Byval p_s)
		If Not Instr(p_s,":") = 2 Then
			p_s = Server.MapPath(p_s)
		End If
		If Right(p_s,1) <> "\" Then
			p_s = p_s & "\"
		End If
		s_path = p_s
	End Property
	
	'''获取缓存路径
	Public Property Get SavePath()
		SavePath = s_path
	End Property
	
	'''所有缓存数据保存为文件缓存
	Public Sub SaveAll()
		Dim t_f
		For Each t_f In Items
			Items(t_f).Save()
		Next
	End Sub
	
	'''所有缓存数据保存为内存缓存
	Public Sub SaveAppAll()
		Dim t_f 
		For Each t_f In Items
			Items(t_f).SaveApp()
		Next
	End Sub
	
	'''清理所有文件缓存
	Public Sub RemoveAll()
		Dim t_f
		For Each t_f In Items
			Items(t_f).Remove()
		Next
	End Sub
	
	'''清理所有内存缓存
	Public Sub RemoveAppAll() 
		Dim t_f
		For Each t_f In Items
			Items(t_f).RemoveApp()
		Next
	End Sub
	
	'''清除所有缓存
	Public Sub [Clear]()
		RemoveAll()
		RemoveAppAll()
		RemoveApp("%Ashapo_Cache_Count%")
	End Sub
End Class
'''缓存信息类
Class CacheInfo
	
	'''缓存存储目录,缓存名,允许缓存计量,缓存后缀名
	Public SavePath, [Name], CountEnabled, FileType
	
	'''缓存存活周期,缓存过期时间,缓存值
	Private s_iexp, s_dexp, s_value
	
	'''构造
	Private Sub Class_Initialize()
		s_iexp = 5
		s_dexp = ""
	End Sub
	
	'''析构
	Private Sub Class_Terminate()
		If IsObject(s_value) Then
			Set s_value = Nothing
		End If
	End Sub
	
	'''设置缓存过期时间
	Public Property Let Expires(Byval p_i)
		If isDate(p_i) Then
			s_dexp = CDate(p_i)
		ElseIf isNumeric(p_i) Then
			If p_i>0 Then
				s_iexp = p_i
			ElseIf p_i=0 Then
				s_iexp = 60*24*365*99
			End If
		End If
	End Property
	
	'''获取缓存过期时间
	Public Property Get Expires()
		Expires = IfHas(s_dexp, s_iexp)
	End Property
	
	'''路径格式化
	Private Function transPath_(Byval p_fe)
		Dim t_p : t_p = ""
		Dim t_parr : t_parr = Split(Me.Name,"/")
		Dim t_i
		for t_i = 0 to UBound(t_parr)
			If RegTest(t_parr(t_i),p_fe) Then
				t_parr(t_i)=Server.URLEncode(t_parr(t_i))
			End If
			t_p = t_p & "_" & t_parr(t_i)
			If t_i < UBound(t_parr) Then
				t_p = t_p & "\"
			End If
		next
		If t_p="" Then t_p="_"
		transPath_ = SavePath & t_p & FileType
	End Function
	
	'''缓存文件路径
	Public Property Get FilePath()
		FilePath = transPath_("[\\:""*?<>|\f\n\r\t\v\s]")
	End Property
	
	'''预删除的缓存文件路径
	Private Function delPath_()
		delPath_ = transPath_("[\\:""<>|\f\n\r\t\v\s]")
	End Function
	
	'''底层改变缓存计数
	Private Function cacheCountChange_(Byval p_a, Byval p_t)
		Dim t_n : t_n = GetApp("%Ashapo_Cache_Count%")
		If isArray(t_n) Then
			If Ubound(t_n) = 1 Then
				If TypeName(t_n(1)) = "Dictionary" Then
					If p_t = 1 Then
						t_n(1)(p_a) = p_a
					End If
					If p_t = -1 Then
						If t_n(1).Exists(p_a) Then
							t_n(1).Remove(p_a)
						End If
					End If
					SetApp "%Ashapo_Cache_Count%", Array(t_n(1).Count,t_n(1))
				End If
			End If
		Else
			Dim t_dic : Set t_dic = Server.CreateObject(C_DicName)
			If p_t = 1 Then
				t_dic(p_a) = p_a
			End If
			SetApp "%Ashapo_Cache_Count%", Array(IIF(p_t=1,1,0),t_dic)
		End If
	End Function
	
	'''设置缓存值
	Public Property Let [Value](Byval p_s)
		If IsObject(p_s) Then
			Select Case TypeName(p_s)
				Case "Recordset"
					Set s_value = p_s.Clone
				Case Else
					Set s_value = p_s
			End Select
		Else
			s_value = p_s
		End If
	End Property
	
	'''获取缓存值,默认
	Public Default Property Get [Value]()
		Dim t_app : t_app = GetApp(Me.Name)
		If IsArray(t_app) Then
			If UBound(t_app) = 1 Then
				If IsDate(t_app(0)) Then
					If IsObject(t_app(1)) Then
						Set [Value] = t_app(1)
						Exit Property
					Else
						[Value] = t_app(1)
						If Has([Value]) Then Exit Property
					End If
				End If
			End If
		End If
		If Fso.IsFile(FilePath) Then
			On Error Resume Next
			Dim t_rs : Set t_rs = Server.CreateObject("Adodb.Recordset")
			t_rs.Open FilePath
			If Err.Number <> 0 Then
				Err.Clear
				[Value] = Fso.Read(FilePath)
			Else
				Set [Value] = t_rs
			End If
		Else
			'Easp.Error.Msg = "("""&Easp.HtmlEncode(Me.Name)&""")" : Easp.Error.Raise 92
			'当前内容不允许缓存到文件缓存
			Errc.Raise(00)
		End If
	End Property
	
	'''保存为内存缓存
	Public Sub SaveApp()
		Dim t_appArr(1) : t_appArr(0) = Now()
		If IsObject(s_value) Then
			Select Case TypeName(s_value)
			Case "Dictionary"
				Set t_appArr(1) = s_value
			Case "Recordset"
				t_appArr(1) = s_value.GetRows(-1)
			Case Else
				'Easp.Error.Msg = "("""&Easp.HtmlEncode(Me.Name)&" &gt; "&TypeName(s_value)&""")" : Easp.Error.Raise 91
				'当前对象不允许缓存到内存缓存
				Errc.Raise(00)
			End Select
		Else
			t_appArr(1) = s_value
		End If
		Call SetApp(Me.Name, t_appArr)
		If CountEnabled Then
			Call cacheCountChange_(Me.Name, 1)
		End If
	End Sub
	
	'''保存为文件缓存
	Public Sub Save()
		Select Case TypeName(s_value)
		Case "Recordset"
			Call Fso.CreateFile(FilePath, "rs")
			Fso.DelFile(FilePath)
			Call s_value.Save(FilePath, adPersistXML)
			If CountEnabled Then
				Call cacheCountChange_(Me.Name, 1)
			End If
		Case "String"
			Call Fso.CreateFile(FilePath, s_value)
			If CountEnabled Then
				Call cacheCountChange_(Me.Name, 1)
			End If
		Case Else
			'Easp.Error.Msg = "("""&Easp.HtmlEncode(Me.Name)&""")" : Easp.Error.Raise 93
			'当前内容不允许缓存到文件缓存
			Errc.Raise(00)
		End Select
	End Sub
	
	'''移除文件缓存
	Public Sub Remove()
		If Not RegTest(delPath_(),"[*?]") Then
			If Fso.IsExists(delPath_()) Then
				Fso.Del(delPath_())
			End If
			If CountEnabled Then
				Call cacheCountChange_(Me.Name, -1)
			End If
		Else
			Fso.DelFile(Left(delPath_(), Len(delPath_())-Len(FileType)))
			Fso.DelFolder(Left(delPath_(), Len(delPath_())-Len(FileType)))
			If CountEnabled Then
				Call cacheCountChange_(Me.Name, -1)
			End If
		End If
	End Sub
	
	'''移除内存缓存
	Public Sub RemoveApp()
		If Has(Me.Name) Then
			RemoveApp(Me.Name)
		End If
		If CountEnabled Then
			Call cacheCountChange_(Me.Name, -1)
		End If
	End Sub

	'''判断缓存是否过期
	Private Function isValid_(Byval p_t)
		If IsDate(p_t) Then
			If Has(s_dexp) Then
				isValid_ = (DateDiff("s", Now(), s_dexp) > 0)
			Else
				isValid_ = (DateDiff("s", p_t, Now()) < s_iexp*60)
			End If
		End If
	End Function
	
	'''缓存有效性判断
	Public Function Ready()
		Dim t_app : t_app = GetApp(Me.Name)
		Ready = False
		If IsArray(t_app) Then
			If UBound(t_app) = 1 Then
				If IsDate(t_app(0)) Then
					Ready = isValid_(t_app(0))
					If Ready Then
						Exit Function
					End If
				End If
			End If
		End If
		If Fso.IsFile(FilePath) Then
			Ready = isValid_(Fso.GetAttr(FilePath,1))
		End If
	End Function
End Class
%>